perm filename M11A.FOR[ZZZ,LCS] blob
sn#439876 filedate 1979-05-08 generic text, type T, neo UTF8
C *** MUSIC V FOR PDP11, AS REVISED BY LELAND SMITH ***
C *********** LIMITS ******************
C 15 INST DEFINITIONS. 20 NOTES PLAYING AT ONCE. 27 DIFFERENT INS. NAMES.
DIMENSION T(50),TI(50),ITI(50)
COMMON /DEVS/ID1,ID21,JTYPE,KIN,KOUT
COMMON I(513) /P/P(50) /FINOUT/JPEAK,IPEAK,NBUF
1 /CONV/ICONV,INIOUT,JFLNM
1 /LFUNC/LFUNC,XNFUN,PINCR /IFIRST/IFIRST,IDT
1 /GENS/GENS(3072) /LOCG/LOCG(6)
DO 10 N1=1,NGENS
10 LOCG(N1)=(N1-1)*LFUNC+1
C ABOVE SETS UP 6 POSSIBLE FUNCS. NUMBER MAY BE INCREASED.
C TO INCREASE NUM. OF GENS AVAILABLE ENLARGE 'GENS' BY 512 PER GEN AND
C PUT PROPER NUMBER INTO 'NGENS' DATA AND 'LOCG' ARRAY SIZE.
C ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
DATA ISRT/10000/, LFUNC/512/, ICONV/-1/,XNFUN/511.0/
1 ,NPAR/35/,NINS/27/,LBLK/512/,NGENS/6/,PFUNC/512.0/,NLIM/700/
C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
C NLIM=NPAR* HOW MANY NOTES CAN PLAY AT ONCE. (NPAR*20=700, RNT SIZE)
COMMON /INS/INS(300),IDEF(15) /NT/RNT(700) /ROUT/ROUT(2560)
C INS=(15)INSTRUMENT DEFINITIONS: EACH INST. CAN USE 15 TO 40+ SLOTS
C IDEF=LOCATION TABLE: 15 INST. DEFS. POSSIBLE AT ONE TIME.
C RNT=PARAM. LIST FOR CURRENTLY PLAYING NOTES. SIZE OF ARRAY SHOULD
C BE A MULTIPLE OF NPAR (35*20 CURRENTLY=20 NOTES CAN PLAY AT ONCE.)
C ***** ONLY 15 DIFFERENT INS NUMBERS CAN BE USED. (1-15) ********
C ROUT=OUTPUT BLOCK (B1→B5)(5*512=2560)(FITS PDP11/70 FORTRAN.)
EQUIVALENCE (I1,I),(I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3)),
1 (P4,P(4)),(I5,I(5)),(I6,I(6)),(I4,I(4)),(P2,P(2)),(I3,I(3))
C SEE BLOCK DATA FOR DEVICE NUMBERS FOR IN-OUT AND TTY.
NBUF=512
1000 INIOUT=-1
C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
IFIRST=-1
IDT=1
C ABOVE 2 ARE IN TRANS. ROUTINES.
JPEAK=0
IPEAK=0
C IPEAK AND JPEAK USED TO TYPE OUT AMPL. INFO. LATER.
I2=1
IF(I4.EQ.0)I4=ISRT
PINCR=PFUNC/I4
C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
MOUT=1
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=1,NLIM,NPAR
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 RNT(N1)=-1
DO 221 N1=1,NINS
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (ID21)
C ID21 IS A DSK DEVICE NUM.
IF(P(1).NE.1.AND.P(1).NE.6)GO TO 200
C JUMP IF A NOTE OR A FINISH
IF(P2.GT.T(1))GO TO 244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALL ERROR(1)
GO TO 204
202 IF(IOP.GT.12)GO TO 201
C ERROR IF OP CODE IS TOO BIG OR <0.
203 GO TO (1,2,3,4,5,6,7,8,201,201,11,11),IOP
11 IVAR=P3
IVARE=IVAR+I1-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
IF(N1.EQ.8)NBUF=512+512*I(N1)
C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
PINCR=PFUNC/I4
C ABOVE FOR AUTOMATIC P2 CONVERSION TO DURATION INCR.
GO TO 204
3 IGEN=P3
IF(P4.GT.NGENS)PAUSE ' FUNC. NUM. OUT RANGE'
C ERROR 4=FUNC NUMB. OUT OF RANGE.
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
7 IF(P4.LT.1)P4=1
C 'SEG' SEG F A,S A,S ... F=FUNC NUM. A=AMPL. S=STEP (1-100)
DO 430 K=4,I1,2
C CONVERT STEPS 1-100 TO 0-511.
430 P(K)=((P(K)-1.)/99.)*511.
530 DO 630 K=I1,1,-1
630 P(K+2)=P(K)
C ABOVE REFORMATS FOR 'GEN' ROUTINES.
P3=IOP-6
P2=0
I1=I1+2
GO TO 3
8 I1=I1+1
C 'SIN' SIN F AH, AH, ... F=FUNC NUM. AH=AMPL OF THAT HARMONIC.
P(I1)=I1-3
C GET TOTAL NUM. OF HARMONICS
GO TO 530
4 IVAR=P3
IVARE=IVAR+I1-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)
GO TO 204
6 CALL FROUT3(IDSK)
CCCC STOP
GO TO 1000
C ENTER NOTE TO BE PLAYED
1 DO 230 N1=1,NLIM,NPAR
230 IF(RNT(N1).EQ.-1)GO TO 231
CALL ERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
WRITE(JTYPE,1230)NINS
C JTYPE IS TTY DEVICE NUMBER.
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=N1
M2=N1+I1-1
M3=M2+1
M4=N1+NPAR-1
DO 232N1=M1,M2
M5=N1-M1+1
232 RNT(N1)=P(M5)
RNT(M1 )=P3
RNT(M1+3)=PINCR/P4
C CONVERTS 'P2' TO PROPER INCREMENT FOR DURATIONS.
IF(M3.GT.M4)GO TO 236
DO 233 N1=M3,M4
233 RNT(N1)=0
236 DO 235 N1=1,NINS
IF(TI(N1)-90909.)235,234,235
234 TI(N1)=P2+P4
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALL ERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I2
M2=IFIX(P3)
IF(M2.GT.15)PAUSE ' ***** INS NUMBER IS TOO HIGH.'
IDEF(M2)=M1
218 CALL DATA (ID21)
IF(I1.GT.2)GO TO 211
210 INS(M1)=0
I2=M1+1
C END OF INST. DEF.
GO TO 204
211 INS(M1)=P3
C P3 IS UNIT GENERATOR CODE NUM.
INS(M1+1)=M1+I1-1
C I1 IS WDCNT OF LAST READIN
M1=M1+2
DO 217N1=4,I1
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 INS(M1)=-1+(M5+101)*LFUNC
GO TO 216
301 INS(M1)=-1+(M5+1)*LBLK
GO TO 216
213 INS(M1)=M5
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T2=P2
250 TMIN=90909.
IREST=1
DO 241N1=1,NINS
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(90909.-TMIN)251,251,243
243 IF(TMIN-T2)245,245,246
245 T3=TMIN
GO TO 260
246 T3=T2
GO TO 260
247 IF(T(1)-T2)249,200,200
249 TI(MNOTE)=90909.
M2=ITI(MNOTE)
RNT(M2)=-1
GO TO 250
C SETUP REST
251 T3=T2
IREST=2
GO TO 260
C PLAY
260 ISAM=(T3-T(1))*FLOAT(I4)+.5
T(1)=T3
IF(ISAM)247,247,266
266 IF(ISAM-LBLK)262,262,263
262 I5=ISAM
ISAM=0
GO TO 264
263 I5=LBLK
ISAM=ISAM-LBLK
264 IF(I(8))290,290,291
290 M3=MOUT+I5-1
MSAMP=I5
GO TO 292
291 M3=MOUT+(2*I5)-1
MSAMP=2*I5
292 DO 267N1=MOUT,M3
267 ROUT(N1)=0
GO TO (268,265),IREST
268 DO 270 NS1=1,NLIM,NPAR
IF(RNT(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I3=NS1
IGEN=RNT(NS1)
IGEN=IDEF(IGEN)
272 I6=IGEN
294 CALL FORSAM
295 IGEN=INS(IGEN+1)
IF(INS(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END
CDATA3 PASS 3 DATA INPUTING ROUTINE
SUBROUTINE DATA (N)
COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK /IFIRST/IFIRST,IDT
COMMON /DEVS/ID1,ID21,JTYPE,KIN,KOUT /JP/JPRNT
EQUIVALENCE (K,I),(P2,P(2))
CALL TRANS(IDT)
IF(JPRNT.LT.0)GO TO 3
C DON'T TYPE BEGIN TIMES IF INPUT IS BEING TYPED OUT. (JPRNT=-1)
IF(P(1).EQ.1)WRITE(JTYPE,1)P2
3 IF(IPEAK.LE.JPEAK)RETURN
WRITE(JTYPE,2)IPEAK
JPEAK=IPEAK
C TYPES OUT EACH NEW PEAK AMPL.
RETURN
1 FORMAT('+',F9.2,$)
2 FORMAT(/' AMPL=',I5,$)
END
SUBROUTINE FROUT3(IDSK)
C TERMINATE OUTPUT
COMMON /DEVS/ID1,ID21,JTYPE,ID23,KOUT
COMMON /ROUT/ROUT(1) /FINOUT/JPEAK,IPEAK /CONV/ICONV
DO 1 K=1,512
1 ROUT(K)=0
CALL SAMOUT(IDSK,512)
IF(JPEAK.LT.IPEAK)JPEAK=IPEAK
WRITE(JTYPE,10)JPEAK
C NOW CLOSE OFF THE FILE
CPDP10 IF(ICONV.LT.0)GO TO 3
CALL CLOSIT(ID23)
CALL EXIT
CPDP10 RETURN
CPDP10 3 CALL FINEXT
C****** TEMPORARY *********
CC IF(KTYPE.EQ.0)GO TO 2
CC COMMON I(513)
CC COMMON /INS/INS(300),IDEF(15) /NT/RNT(700)
CC CALL OFILE(24,'SAM')
CC WRITE(24,4)IDEF
CC WRITE(24,4)INS
CC WRITE(24,5)RNT
CC WRITE(24,4)I
CC CALL EXIT
CC4 FORMAT(8I10)
CC
CC5 FORMAT(8F10.4)
CC2 CALL PLAY
CC RETURN
10 FORMAT (/' PEAK AMPLITUDE WAS ',I6)
END